home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / C64 / A-Monthly Disks / (c)abm1.d64 / bytes (.txt) < prev    next >
Commodore BASIC  |  2007-02-04  |  8KB  |  250 lines
  1. 0 POKE52,56:POKE51,0:POKE56,56:POKE55,0:CLR
  2. 1 DIMA$,A,II,JJ,TE,I,J,X,Y,VA,T2,TC,T,SU,T,J%,F,FC,FR,FS,J9,BA,CA,I3,NC,NS,SU$
  3. 2 DEFFNS(X)=INT(X/13):DEFFNV(X)=X-13*INT(X/13):NS=13:NC=52:II=827
  4. 3 JJ=-1:DIMG$(NS),S(NC),X(11),Y(11)     :FORI=0TONC-1:S(I)=I:NEXT
  5. 4 G$(1)="SETUP":G$(2)="TITLE":G$(3)="ANYKEY":G$(4)="GETKEY":G$(5)="PRINTAT"
  6. 5 G$(6)="CARD":G$(7)="HELP":G$(8)="BOARD":G$(9)="DEAL":G$(10)="WIN"
  7. 6 G$(11)="SHUFFLE":G$(12)="CHOICE":G$(13)="QUIT" :GOTO403
  8. 7 :
  9. 8 REM NAME THAT SUBROUTINE
  10. 9 :
  11. 10 FORI3=1TONS:IFSU$=G$(I3)THEN12
  12. 11 NEXT:PRINT"ERROR";SU$:END
  13. 12 ONI3GOTO111,348,58,62,66,200,304,360,134,26,140,20,48
  14. 17 :
  15. 18 REM CHOICE
  16. 19 :
  17. 20 SUB$="GETKEY":GOSUB10
  18. 21 FORI=1TO10:IFA$=MID$(CH$,I,1)THENRETURN
  19. 22 NEXT:GOTO20
  20. 23 :
  21. 24 REM FANFARE
  22. 25 :
  23. 26 T=87:A$="251331421502421502"
  24. 27 POKEF+6,96:POKEF+24,15
  25. 28 FORI=1TO18STEP3
  26. 29 POKEF+1,VAL(MID$(A$,I,2)):POKEF+4,33
  27. 30 FORJ=1TOT*VAL(MID$(A$,I+2,1)):NEXT
  28. 31 POKEF+4,0:NEXT:X=4:Y=15:SUB$="PRINTAT":GOSUB10
  29. 32 PRINT"[156][176][192][192][192][192][192][192][192][174][157][157][157][157][157][157][157][157][157][221]YOU WIN[255][157][157][157][157][157][157][157][157][157][173][196][196][196][196][196][196][196][189]"
  30. 33 FORI=1TO1200:NEXT
  31. 37 :
  32. 38 REM AGAIN
  33. 39 :
  34. 40 X=4:Y=19:SUB$="PRINTAT":GOSUB10
  35. 42 PRINT"[129][176][192][192][192][192][192][192][192][192][174][157][157][157][157][157][157][157][157][157][157][221] AGAIN  [255][157][157][157][157][157][157][157][157][157][157][221] (Y/N)? [255]";
  36. 44 PRINT"[157][157][157][157][157][157][157][157][157][157][173][196][196][196][196][196][196][196][196][189]":RETURN
  37. 45 :
  38. 46 REM QUIT
  39. 47 :
  40. 48 T=0:FORJ=1TO7:T=T+C(J):NEXT:X=2:Y=14:SUB$="PRINTAT":GOSUB10
  41. 49 PRINT"[156][213][192][192][192][192][192][192][192][192][192][192][192][192][174][157][157][157][157][157][157][157][157][157][157][157][157][157][157][221] CARDS LEFT [255][157][157][157][157][157][157][157][157][157][157][157][157][157][157][221]";
  42. 50 PRINT"            [255][157][157][157][157][157][157][157][157][157][157][157][157][157][157][173][196][196][196][196][196][196][196][196][196][196][196][196][189][145][157][157][157][157][157][157][157][157][157]";T:GOTO33
  43. 55 :
  44. 56 REM ANY KEY-GET A$
  45. 57 :
  46. 58 X=10:Y=24:SUB$="PRINTAT":GOSUB10:PRINT" PLEASE PRESS A KEY [145][145][145]"
  47. 59 :
  48. 60 REM GET A$
  49. 61 :
  50. 62 GETA$:IFA$=""THEN70:RETURN
  51. 63 :
  52. 64 REM PRINT AT
  53. 65 :
  54. 66 POKE211,X:POKE214,Y:SYS58732:RETURN
  55. 67 :
  56. 68 REM MULTITASK-NOT SUBROUTINE
  57. 69 :
  58. 70 IFJJ=NC-2THEN62
  59. 71 IFII=930THEN74
  60. 72 II=II+1:READA:POKEII,A:GOTO62
  61. 74 JJ=JJ+1:J%=JJ+INT(RND(0)*(NC-JJ)):TEMP=S(JJ):S(JJ)=S(J%):S(J%)=TEMP:GOTO62
  62. 108 :
  63. 109 REM DIM,DEFINE,ONCE ONLY STUFF
  64. 110 :
  65. 111 NC=52:DIMVA$(13),C(11),B(11,46):F=54272
  66. 112 FORI=FTOF+24:POKEF,0:NEXT
  67. 115 FORI=0TO3:READS$(I):READCO$(I):NEXT
  68. 119 FORI=0TO12:READVA$(I):NEXT
  69. 120 CH$="1234567FHQ"
  70. 121 FORI=1TO11:READX(I),Y(I):NEXT:RETURN
  71. 123 DATA"[216]","[144]","[218]","","[211]","","[193]","[144]",A,2,3,4,5,6,7,8,9,10,J,Q,K
  72. 125 DATA2,10,9,10,18,8,25,8,32,8,25,0,25,16,18,0,32,0,18,16,32,16
  73. 131 :
  74. 132 REM DEAL
  75. 133 :
  76. 134 FOR I=0TO45:B(1,I+1)=S(I):NEXT:I=45:FORJ=3TO8:I=I+1:B(J,1)=S(I):C(J)=1:NEXT
  77. 136 C(1)=46:C(2)=0:C(9)=0:C(10)=0:C(11)=0:BA=FNV(B(8,1)):RETURN
  78. 137 :
  79. 138 REM SHUFFLE
  80. 139 :
  81. 140 IFJJ=NC-2THENRETURN
  82. 142 IFII=930THEN146
  83. 144 II=II+1:READA:POKEII,A:GOTO142
  84. 146 JJ=JJ+1:J%=JJ+INT(RND(0)*(NC-JJ)):TEMP=S(JJ):S(JJ)=S(J%):S(J%)=TEMP
  85. 148 IFJJ<>NC-2THEN146
  86. 150 RETURN
  87. 197 :
  88. 198 REM CARD
  89. 199 :
  90. 200 CA=B(I,C(I)):SU=FNS(CA):VA=FNV(CA):X=X(I):Y=Y(I):SUB$="PRINTAT":GOSUB10
  91. 204 POKEF+24,15:POKEF+5,128:POKEF+4,129:FORT=1TO50:NEXT:POKEF+4,128:POKEF+5,0
  92. 206 POKEF+24,0:POKEF+24,15:POKEF+4,129:POKEF+4,128
  93. 208 IFC(I)<>0THEN220
  94. 216 PRINT"      [157][157][157][157][157][157]      [157][157][157][157][157][157]      [157][157][157][157][157][157]      ";
  95. 218 PRINT"[157][157][157][157][157][157]      [157][157][157][157][157][157]      [157][157][157][157][157][157]      ";:RETURN
  96. 220 PRINT"[176][192][192][192][192][174][157][157][157][157][157][157][221]    [255][157][157][157][157][157][157][221] [166][167] [255][157][157][157][157][157][157][221] [170][171] [255]";
  97. 222 PRINT"[157][157][157][157][157][157][221] [168][169] [255][157][157][157][157][157][157][221]    [255][157][157][157][157][157][157][173][196][196][196][196][189]
  98. 224 SUB$[178]"PRINTAT":[141]10
  99. 225 [139]VA[179][177]9[167]227
  100. 226 [153]"";CO$(SU);VA$(VA);"CMDCMD";S$(SU);"";S$(SU);"CMDCMD";VA$(VA):[142]
  101. 227 [153]"";CO$(SU);VA$(VA);"CMD";S$(SU);"";S$(SU);"CMD";VA$(VA):[142]
  102. 301 :
  103. 302 [143] HELP
  104. 303 :
  105. 304 [151]53280,1:[151]53281,1:[153]"LOAD       ANDPOSNEWNEWNEW FOUR SEASONS NEWNEWNEWPOSAND "
  106. 306 [153]" THE FOUNDATIONS [F] ARE BUILT UPWARD BY";
  107. 308 [153]"SUIT WITH KING 'WRAPPING' TO ACE.  EACH
  108. 310 PRINT"PILE  IN  THE  TABLEAU  [3-7]  IS BUILT
  109. 312 [153]"DOWNWARD, REGARDLESS OF SUIT, WITH ACES
  110. 314 PRINT"'WRAPPING' TO KINGS.
  111. 316 [153]:[153]" THE FOUNDATION CARDS WILL BE THE OTHER
  112. 318 PRINT"THREE  CARDS  OF THE SAME  VALUE AS THE
  113. 320 [153]"ONE  DEALT.  ONE CARD AT A TIME CAN BE
  114. 322 PRINT"MOVED FROM THE TOP OF ANY PILE [2-7] TO
  115. 324 [153]"ANY PILE EXCEPT THE WASTE [2].
  116. 326 PRINT:PRINT" TURN CARDS UP FROM THE STOCK [1] ONE
  117. 328 [153]"AT A TIME.  THE CARD WILL BE PLACED ON
  118. 330 PRINT"THE WASTE PILE. FILL EMPTY SPACES [3-7]
  119. 332 [153]"FROM ANY PILE. FOLLOW THE PROMPTS BELOW
  120. 334 PRINT"THE DECK.  CARDS  WILL BE PLAYED TO THE
  121. 336 [153]"PROPER FOUNDATION  WHEN YOU SELECT 'F'."
  122. 338 [153]"IN  ORDER  TO  WIN,  ALL CARDS MUST BE
  123. 339 PRINT"PLAYED TO THE FOUNDATIONS. NO REDEAL IS
  124. 340 [153]"ALLOWED.":[139]J9[178]1[167]342
  125. 341 [153]"          A MOMENT, PLEASEONON";:J9[178]1:SUB$[178]"SHUFFLE":[141]10
  126. 342 [153]"ONON": SUB$[178]"ANYKEY":[141]10:[142]
  127. 345 :
  128. 346 [143] TITLE
  129. 347 :
  130. 348 [151]53280,0:[151]53281,0:[153]"LOADPRINT"[199](142)""
  131. 349 [153]"TANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTAN"
  132. 350 [153]"DEFTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTAN"
  133. 351 [153]"PRINT        F O U R    S E A S O N S
  134. 352 PRINT"[150]        A CLASSIC SOLITAIRE GAME
  135. 353 [153]"PRINT            BY MAURICE JONES
  136. 354 PRINT"[150][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]
  137. 355 [153]"PRINTTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTANTAN"
  138. 356 [141]60000:[142]
  139. 357 :
  140. 358 [143] BOARD
  141. 359 :
  142. 360 [151]53280,1:[151]53281,1:[153]"LOAD    ORTANTANTANTANTANTANTANTANTAN^
  143. 361 PRINT"    [221]  FOUR   [255]
  144. 362 [153]"    (null) SEASONS (null)
  145. 363 PRINT"    [173][196][196][196][196][196][196][196][196][196][189]
  146. 364 [153]"STOP      H-HELP
  147. 365 PRINT"      Q-QUIT         F      6      F
  148. 366 [153]"                     3      4      5
  149. 368 PRINT"     1      2"
  150. 371 PRINT"                     F      7      F";
  151. 372 FORI=3TO8:SUB$="CARD":GOSUB10:NEXT:X=X(1):Y=Y(1):SUB$="PRINTAT":GOSUB10
  152. 373 PRINT"[176][192][192][192][192][174][157][157][157][157][157][157][221][166][164][164][167][255][157][157][157][157][157][157][221][170][172][172][171][255][157][157][157][157][157][157][221][170][172][172][171][255]";
  153. 374 PRINT"[157][157][157][157][157][157][221][170][172][172][171][255][157][157][157][157][157][157][221][168][165][165][169][255][157][157][157][157][157][157][173][196][196][196][196][189][145][145][145][145][145][157][157][157][157][157]";:RETURN
  154. 375 :
  155. 376 REM SS DATA
  156. 377 :
  157. 379 DATA169,000,133,251,133,253,141
  158. 380 DATA055,003,141,057,003,141,059
  159. 381 DATA003,162,000,160,000,177,251
  160. 382 DATA145,253,200,192,000,208,247
  161. 383 DATA230,252,230,254,232,224,004
  162. 384 DATA208,238,173,056,003,133,252
  163. 385 DATA173,058,003,133,254,238,059
  164. 386 DATA003,174,059,003,224,002,208
  165. 387 DATA214,096,169,004,133,252,169
  166. 388 DATA192,133,254,169,216,141,056
  167. 389 DATA003,169,196,141,058,003,076
  168. 390 DATA060,003,169,192,133,252,169
  169. 391 DATA004,133,254,169,196,141,056
  170. 392 DATA003,169,216,141,058,003,076
  171. 393 DATA060,003,000,000,000
  172. 400 :
  173. 401 REM START
  174. 402 :
  175. 403 SUB$="TITLE":GOSUB10:SUB$="SETUP":GOSUB10
  176. 408 SUB$="HELP":GOSUB10:J9=1
  177. 412 JJ=-1:SUB$="DEAL":GOSUB10:SUB$="BOARD":GOSUB10
  178. 416 FORJ=9TO11:X=X(J):Y=Y(J):SUB$="PRINTAT":GOSUB10:PRINT"";VA$(BA):NEXT
  179. 418 X=3:Y=22:SUB$="PRINTAT":GOSUB10:PRINT"[156]BASE CARD- ";VA$(BA);
  180. 424 X=3:Y=19:SUB$="PRINTAT":GOSUB10:PRINT"  FROM ? [157][157]";
  181. 428 SUB$="CHOICE":GOSUB10:A$="":IFC(I)=0ANDI<8THEN430
  182. 429 ONIGOTO460,500,500,500,500,500,500,430,440,450
  183. 430 X=3:Y=19:SUB$="PRINTAT":GOSUB10:PRINT" ILLEGAL ":FORJ=1TO700:NEXT:GOTO424
  184. 440 SYS886:SUB$="HELP":GOSUB10:SYS907:GOTO424
  185. 450 SUB$="QUIT":GOSUB10
  186. 452 SUB$="GETKEY":GOSUB10:IFA$="Y"THEN 412
  187. 454 IFA$="N"THEN1000
  188. 458 GOTO450
  189. 460 C(2)=C(2)+1:B(2,C(2))=B(1,C(1)):C(1)=C(1)-1:IFC(1)=0THEN470
  190. 464 I=2:SUB$="CARD":GOSUB10:IFC(1)=0THEN474
  191. 466 GOTO424
  192. 470 I=1:SUB$="CARD":GOSUB10:GOTO464
  193. 474 X=0:Y=20:SUB$="PRINTAT":GOSUB10
  194. 476 PRINT"[156]   [176][192][192][192][192][192][192][192][192][192][192][174]
  195. 477 [153]"   (null) USE Q TO (null)
  196. 478 PRINT"   [221] END GAME [255]
  197. 479 [153]"   /STR$STR$STR$STR$STR$STR$STR$STR$STR$STR$EXP":[137]424
  198. 500 FR[178]I:X[178]3:Y[178]19:SUB$[178]"PRINTAT":[141]10:[153]"   TO ?   "
  199. 504 SUB$[178]"CHOICE":[141]10:A$[178]""
  200. 508 [145]I[137]430,430,520,520,520,520,520,580,440,450
  201. 517 :
  202. 518 [143] PLAY TO CROSS
  203. 519 :
  204. 520 T2[178]I:FC[178][165]V(B(FR,C(FR)))
  205. 528 TC[178][165]V(B(T2,C(T2))):
  206. 532 [139]FC[170]1[178]TC[176](TC[178]0[175]FC[178]12)[167]540
  207. 534 [139]C(T2)[178]0[167]540
  208. 536 [137]430
  209. 540 C(T2)[178]C(T2)[170]1:B(T2,C(T2))[178]B(FR,C(FR)):C(FR)[178]C(FR)[171]1:I[178]FR:SUB$[178]"CARD"
  210. 544 [141]10: I[178]T2:SUB$[178]"CARD":[141]10:[137]424
  211. 577 :
  212. 578 [143] PLAY TO FOUNDATIONS
  213. 579 :
  214. 580 T2[178]I:FC[178][165]V(B(FR,C(FR))):FS[178][165]S(B(FR,C(FR)))
  215. 588 [129]J[178]8[164]11:[139]C(J)[178]0[175]FC[178]BA[167]596
  216. 592 [137]610
  217. 596 C(J)[178]C(J)[170]1:B(J,1)[178]B(FR,C(FR)):C(FR)[178]C(FR)[171]1
  218. 598 I[178]FR:SUB$[178]"CARD":[141]10:I[178]J:SUB$[178]"CARD":[141]10
  219. 600 [139]C(8)[170]C(9)[170]C(10)[170]C(11)[178]52[167]SUB$[178]"WIN":[141]10:[137]452
  220. 604 [137]424
  221. 610 [139]FS[179][177][165]S(B(J,C(J)))[167]622
  222. 614 [139](FC[171]1 [178][165]V(B(J,C(J))))[167]618
  223. 615 [139][165]V(B(J,C(J)))[178]12[175]FC[178]0[167]618
  224. 616 [137]622
  225. 618 C(J)[178]C(J)[170]1:B(J,C(J))[178]B(FR,C(FR)):C(FR)[178]C(FR)[171]1:[137]598
  226. 622 [130]J
  227. 626 [137]430
  228. 997 :
  229. 998 [143] QUIT TO LOADSTAR
  230. 999 :
  231. 1000 [159]15,8,15,"R0:HELLO CONNECT=HELLO CONNECT":[132]15,ER:[160]15
  232. 1010 [139]ER[179][177]63[167][128]
  233. 1020 [151]53281,0:[151]53280,0:[153]"LOADSTOPLOAD"[199](34)"HELLO CONNECT"[199](34)",8"
  234. 1030 [153]"RUN"
  235. 1040 [151]631,13:[151]632,13:[151]198,2:[128]
  236. 10000 [159]15,8,15,"S0:BYTES":[160]15:[148]"BYTES",8:[128]
  237. 60000 B9$[178]"                                      "
  238. 60010 [151]214,14:[153]:[153]"  LISTFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREFREPRINT#"
  239. 60020 [129]I[178]0[164]7:[153]B9$:[130]:[153]"  POKEPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPRINT#"
  240. 60030 B9$(0)[178]"BYTES: BASIC MAKES A CALL"
  241. 60040 B9$(1)[178]"BY MAURICE JONES
  242. 60050 B9$(2)="(C) 1990 BY SOFTDISK, INC."
  243. 60060 B9$(3)="PUBLISHED ON LOADSTAR #75"
  244. 60070 B9$(4)="SUBSCRIPTIONS 1-800-831-2694"
  245. 60080 B9$(5)="ALL RIGHTS RESERVED"
  246. 60090 POKE214,16:PRINT:FORI=0TO5:PRINTTAB(20-(LEN(B9$(I))/2))""B9$(I):NEXT
  247. 60095 SYS57812"SEASONS FONT",8,0:POKE780,0:POKE781,0:POKE782,56:SYS65493
  248. 60097 POKE53272,31
  249. 60099 RETURN
  250.